home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 20 / Cream of the Crop 20 (Terry Blount) (1996).iso / program / pcl4p51.zip / DOOR.PAS < prev    next >
Pascal/Delphi Source File  |  1996-06-04  |  5KB  |  137 lines
  1. (*************************************************************)
  2. (*                                                           *)
  3. (*          DOOR.PAS           April 95                      *)
  4. (*                                                           *)
  5. (*   EXAMPLE CODE: Gain control w/o resetting UART.          *)
  6. (*                                                           *)
  7. (*   (1) Start your communications program such as PROCOMM   *)
  8. (*   (2) Select "DOS gateway" to get the DOS prompt.         *)
  9. (*   (3) Start this program. You will gain control of the    *)
  10. (*       COM port without resetting the UART or dropping the *)
  11. (*       modem carrier.                                      *)
  12. (*   (4) When done, exit this program, then type EXIT to     *)
  13. (*       return to MSDOS.                                    *)
  14. (*                                                           *)
  15. (*   For more information, see documentation.                *)
  16. (*                                                           *)
  17. (*************************************************************)
  18.  
  19.  
  20. program door;
  21. uses crt, PCL4P;
  22.  
  23. var
  24.    BaudCode : Integer;
  25.    RetCode  : Integer;
  26.    Byte : Char;
  27.    i    : Integer;
  28.    Port : Integer;
  29.    ResetFlag : Boolean;
  30.    BufPtr    : Pointer;
  31.    BufSeg    : Integer;
  32.  
  33. procedure SayError( Code : Integer );
  34. var
  35.    RetCode : Integer;
  36. begin
  37.    if Code < 0 then RetCode := SioError( Code )
  38.    else if (Code and (FramingError or ParityError or OverrunError)) <> 0 then
  39.       begin (* Port Error *)
  40.          if (Code and FramingError) <> 0 then writeln('Framing Error');
  41.          if (Code and ParityError)  <> 0 then writeln('Parity Error');
  42.          if (Code and OverrunError) <> 0 then writeln('Overrun Error')
  43.       end
  44. end;
  45.  
  46. procedure MyHalt( Code : Integer );
  47. var
  48.    RetCode : Integer;
  49. begin
  50.    if Code < 0 then SayError( Code );
  51.    if ResetFlag then RetCode := SioDone(Port);
  52.    writeln('*** HALTING ***');
  53.    Halt;
  54. end;
  55.  
  56. begin   (* main program *)
  57.    (* fetch PORT # from command line *)
  58.    if ParamCount <> 1 then
  59.       begin
  60.          writeln('USAGE: "DOOR <port> "');
  61.          halt;
  62.       end;
  63.    Val( ParamStr(1),Port, RetCode );
  64.    if RetCode <> 0 then
  65.       begin
  66.          writeln('Port must be 1 to 16');
  67.          Halt;
  68.       end;
  69.    (* COM1 = 0, COM2 = 1, etc. *)
  70.    Port := Port - 1;
  71.    if (Port<COM1) or (Port>COM16) then
  72.       begin
  73.          writeln('Port must be 1 to 16');
  74.          Halt
  75.       end;
  76.    (* setup 1K receive buffer *)
  77.    GetMem(BufPtr,1024+16);
  78.    BufSeg := Seg(BufPtr^) + ((Ofs(BufPtr^)+15) SHR 4);
  79.    RetCode := SioRxBuf(Port, BufSeg, Size1024);
  80.    if RetCode < 0 then MyHalt( RetCode );
  81.    if SioInfo('I') > 0 then
  82.      begin
  83.        (* setup 128 transmit buffer *)
  84.        GetMem(BufPtr,128+16);
  85.        BufSeg := Seg(BufPtr^) + ((Ofs(BufPtr^)+15) SHR 4);
  86.        RetCode := SioTxBuf(Port, BufSeg, Size128);
  87.        if RetCode < 0 then MyHalt( RetCode );
  88.      end;
  89.    (* reset port *)
  90.    RetCode := SioReset(Port,NORESET);
  91.    (* if error then try one more time *)
  92.    if RetCode <> 0 then RetCode := SioReset(Port,NORESET);
  93.    (* Was port reset ? *)
  94.    if RetCode <> 0 then
  95.      begin
  96.         writeln('Cannot reset COM',Port+1);
  97.         MyHalt( RetCode );
  98.      end;
  99.    (* Port successfully reset *)
  100.    writeln;
  101.    writeln('COM',1+Port);
  102.  
  103.    (* begin terminal loop *)
  104.    writeln('Enter terminal loop ( Type ^Z to exit )');
  105.    while TRUE do
  106.       begin
  107.          (* did user press Ctrl-BREAK ? *)
  108.          if SioBrkKey then
  109.             begin
  110.                writeln('User typed Ctl-BREAK');
  111.                RetCode := SioDone(Port);
  112.                Halt;
  113.             end;
  114.          (* anything incoming over serial port ? *)
  115.          RetCode := SioGetc(Port,0);
  116.          if RetCode < -1 then MyHalt( RetCode );
  117.          if RetCode > -1 then Write( chr(RetCode) );
  118.          (* has user pressed keyboard ? *)
  119.          if KeyPressed then
  120.             begin
  121.                (* read keyboard *)
  122.                Byte := ReadKey;
  123.                (* quit if user types ^Z *)
  124.                if Byte = chr($1a) then
  125.                   begin
  126.                      writeln('User typed ^Z');
  127.                      RetCode := SioDone(Port);
  128.                      Halt;
  129.                   end;
  130.                (* send out over serial line *)
  131.                RetCode := SioPutc(Port, Byte );
  132.                if RetCode < 0 then MyHalt( RetCode );
  133.             end
  134.       end
  135. end.
  136.  
  137.